home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
likene1a
/
frmmenu.frm
(
.txt
)
next >
Wrap
Visual Basic Form
|
1999-09-24
|
5KB
|
168 lines
VERSION 5.00
Begin VB.Form frmMenu
Caption = "Form2"
ClientHeight = 3165
ClientLeft = -195
ClientTop = 4290
ClientWidth = 4680
LinkTopic = "Form2"
ScaleHeight = 3165
ScaleWidth = 4680
Begin VB.Timer Timer1
Left = 1080
Top = 2040
End
Begin VB.Menu mnuFile
Caption = "File"
Begin VB.Menu MnuPlay
Caption = "Play"
End
Begin VB.Menu MnuStop
Caption = "Stop"
End
Begin VB.Menu MnuPause
Caption = "Pause"
End
Begin VB.Menu MnuEject
Caption = "Eject"
End
End
Attribute VB_Name = "Frmmenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MnuEject_Click()
SendMCIString "set cd door open", True
Update
End Sub
Private Sub MnuExit_Click()
SendMCIString "pause cd", True
fPlaying = False
End Sub
Private Sub MnuPause_Click()
SendMCIString "pause cd", True
fPlaying = False
Update
End Sub
Private Sub MnuPlay_Click()
SendMCIString "play cd", True
fPlaying = True
End Sub
Private Sub MnuStop_Click()
SendMCIString "stop cd wait", True
cmd = "seek cd to " & Track
SendMCIString MnuStop, True
fPlaying = False
Update
End Sub
Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
Static rc As Long
Static errStr As String * 200
rc = mciSendString(cmd, 0, 0, hWnd)
If (fShowError And rc <> 0) Then
End If
SendMCIString = (rc = 0)
End Function
Private Sub Command1_Click()
Snd.CloseCD
End Sub
Private Sub Command7_Click()
End Sub
Private Sub Command8_Click()
End Sub
Private Sub alwaysontop_Click()
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
fastForwardSpeed = 5
fCDLoaded = False
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
End If
SendMCIString "set cd time format tmsf wait", True
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
SendMCIString "close all", False
End Sub
Private Sub play_Click()
SendMCIString "play cd", True
fPlaying = True
End Sub
Private Sub REMontop_Click()
End Sub
Private Sub pause_Click()
SendMCIString "pause cd", True
fPlaying = False
Update
End Sub
Private Sub eject_Click()
SendMCIString "set cd door open", True
Update
End Sub
Private Sub ff_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) + fastForwardSpeed * 1000)
cmd = "seek cd to " & CStr(CLng(s) + fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub
Private Sub rew_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) - fastForwardSpeed * 1000)
cmd = "seek cd to " & CStr(CLng(s) - fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub
Private Sub Update()
Static s As String * 30
mciSendString "status cd media present", s, Len(s), 0
If (CBool(s)) Then
If (fCDLoaded = False) Then
mciSendString "status cd number of tracks wait", s, Len(s), 0
numTracks = CInt(Mid$(s, 1, 2))
MnuEject.Enabled = True
If (numTracks = 1) Then
Exit Sub
End If
mciSendString "status cd length wait", s, Len(s), 0
Dim i As Integer
For i = 1 To numTracks
cmd = "status cd length track " & i
mciSendString cmd, s, Len(s), 0
Next
MnuPlay.Enabled = True
MnuPause.Enabled = True
MnuStop.Enabled = True
fCDLoaded = True
SendMCIString "seek cd to 1", True
End If
mciSendString "status cd position", s, Len(s), 0
Track = CInt(Mid$(s, 1, 2))
Min = CInt(Mid$(s, 4, 2))
Sec = CInt(Mid$(s, 7, 2))
mciSendString "status cd mode", s, Len(s), 0
fPlaying = (Mid$(s, 1, 7) = "playing")
MnuEject.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Update
End Sub